1000 SYS700:.OPT OO
1010 *=$C000
1020 ;
1030 ;********************************
1040 ;*                              *
1050 ;*           SNAG 1.0           *
1060 ;*                              *
1070 ;* COPYRIGHT 1987  BY NICK PECK *
1080 ;*                              *
1090 ;********************************
1100 ;
1110 NMIOFF =$FEC1 ;RESTORE IS OFF HERE
1120 STUFF  =$F000 ;MEM. FOR SNAG STACK
1130 STRING =$AB1E ;DISPLAY A STRING
1140 GETIN  =$FFE4 ;GET A KEYBOARD BYTE
1150 CHROUT =$FFD2 ;OUTPUT A BYTE
1160 CHRIN  =$FFCF ;64'S INPUT ROUTINE
1170 PLOT   =$FFF0 ;PLOT 64'S CURSOR
1180 CLOSE  =$FFC3 ;CLOSE A FILE
1190 CLALL  =$FFE7 ;CLOSE ALL FILES
1200 OPEN   =$FFC0 ;OPEN A FILE
1210 SETNAM =$FFBD ;SET FILE NAME
1220 SETLFS =$FFBA ;SET FILE STATUS
1230 TALK   =$FFB4 ;MAKE DEVICE TALK
1240 TKSA   =$FF96 ;TALK SECOND ADDRESS
1250 CHKOUT =$FFC9 ;OPEN OUTPUT CHANNEL
1260 UNTLK  =$FFAB ;MAKE DEVICE UNTALK
1270 ACPTR  =$FFA5 ;SERIAL PORT GET
1280 CURSCO =$0286 ;64'S CURSOR COLOR
1290 SCNLIN =$0748 ;START OF MENU
1300 TXTLIN =$0770 ;START OF TEXT LINE
1310 COLLIN =$DB48 ;MENU COLOR MEMORY
1320 A      =$02 ;TEMPS USED EVERYWHERE
1330 B      =$03 ;     ''      ''
1340 XTEMP  =$04 ;     ''      ''
1350 YTEMP  =$05 ;     ''      ''
1360 BLOCKX =$FD ;POSITION OF BLOCK
1370 BLOCKY =$FE ;     ''      ''
1380 XPOS   =$FB ;POSITION OF CURSOR
1390 YPOS   =$FC ;     ''      ''
1400 LOWPNT =$06 ;LOW-HIGH USED IN PLOT
1410 HIGHPT =$07 ;     ''      ''
1420 COLLOW =$22 ;USED TO GET OLD COLOR
1430 COLHII =$23 ;     ''      ''
1440 OLDCOL =$24 ;FLAG- USE OLD COLOR
1450 ADDMOV =$25 ;FLAG- RIGHT OR DOWN
1460 XPTEMP =$4B ;TEMP FOR MAKE BLOCK
1470 YPTEMP =$4C ;     ''      ''
1480 XBTEMP =$4D ;     ''      ''
1490 YBTEMP =$4E ;     ''      ''
1500 FLPPLT =$4F ;FLAG- PLOT Y,X *(X,Y)
1510 OUTPUT =$50 ;FLAG- OUTPUT UNBLOCK
1520 LASTCH =$51 ;TEMP FOR UNBLOCK
1530 CHOICE =$52 ;APPEND CHOICE (Y/N)
1540 CURCOL =$53 ;CURRENT SNAG COLOR
1550 QTMODE =$D4 ;64 QUOTE MODE ON/OFF
1560 ;
1570 ;THE FOLLOWING CODE COPIES THE
1580 ;STACK AND ZERO PAGE SO THAT SNAG
1590 ;HAS IT'S OWN STACK AND ZERO PAGE
1600 ;WHEN ENTERED VIA THE HARDWARE IRQ
1610 ;
1620 INTSTR LDA #"N"      ;START APPEND
1630        STA CHOICE    ;CHOICE AS 'N
1640        LDA #"/"
1650        STA FNAME     ;START FILE
1660        LDA #","      ;NAME AS '/'
1670        STA FNAME+1
1680        SEI
1690        LDA #>RTHERE   ;SET RETURN
1700        PHA            ;ADDRESS FOR
1710        LDA #<RTHERE-1 ;FLIP STACK
1720        PHA            ;ROUTINE.
1730        TSX            ;SAVE STACK
1740        STX STKTMP     ;POINTER
1750        LDA #0
1760        STA $FB        ;COPY FIRST
1770        STA $FC        ;4 BLOCKS OF
1780        LDA #<STUFF    ;MEMORY
1790        STA $FD
1800        LDA #>STUFF
1810        STA $FE
1820        LDX #4
1830        LDY #2
1840 MRTOIT LDA ($FB),Y
1850        STA ($FD),Y
1860        INY
1870        BNE MRTOIT
1880        INC $FC
1890        INC $FE
1900        DEX
1910        BNE MRTOIT
1920        LDA #<NMIOFF  ;SNAG VECTORS
1930        STA $0318     ;SNAG RESTORE
1940        LDA #>NMIOFF  ;IS DISABLED
1950        STA $0319
1960        LDA #<EXTSNG  ;BRK VECTOR
1970        STA $0316     ;IS USED TO
1980        LDA #>EXTSNG  ;EXIT SNAG
1990        STA $0317
2000        LDA #>START  ;NEW PCH
2010        PHA
2020        LDA #<START  ;NEW PCL
2030        PHA
2040        LDA #0       ;STATUS
2050        PHA
2060        PHA          ;.A
2070        PHA          ;.X
2080        PHA          ;.Y
2090        LDA #>RTHRE2   ;SET RETURN
2100        PHA            ;ADDRESS FOR
2110        LDA #<RTHRE2-1 ;NEXT FLIP
2120        PHA            ;STACK CALL
2130        JMP FLIPMM   ;FLIP STACKS
2140 RTHERE LDA #<BASERR ;CHANGE BASICS
2150        STA $0300    ;ERROR MESSAGE
2160        LDA #>BASERR ;VECTOR TO
2170        STA $0301    ;RESET IRQ
2180        CLI
2190        LDA #96      ;PUT AN RTS
2200        STA INTSTR   ;IN FIRST BYTE
2210        RTS
2220 ;
2230 ;EVERY TIME BASIC PRINTS AN ERROR
2240 ;OR A 'READY' THE IRQ VECTOR IS
2250 ;SET TO SNAG
2260 ;
2270 BASERR SEI
2280        LDY #<(null)THER ;NEW IRQ THAT
2290        STY $0314    ;LOOKS FOR A
2300        LDY #>(null)THER ;CTRL-F3
2310        STY $0315
2320        CLI
2330        JMP $E38B
2340 ;
2350 ;THE IRQ COMES HERE TO LOOK FOR
2360 ;A CTRL-F3
2370 ;
2380 (null)THER LDA $C5      ;LOOK FOR F3
2390        CMP #5
2400        BEQ YESF3
2410 OUTIRQ JMP $EA31
2420 YESF3  LDA $028D    ;LOOK FOR CTRL
2430        CMP #4
2440        BNE OUTIRQ
2450        LDA #>RETEXT
2460        PHA
2470        LDA #<RETEXT-1
2480        PHA
2490        JMP FLIPMM   ;FLIP STACKS
2500 RTHRE2 JMP $EA31
2510 ;
2520 EXTSNG LDA #>RTHRE2
2530        PHA
2540        LDA #<RTHRE2-1
2550        PHA
2560        JMP FLIPMM   ;FLIP STACKS
2570 RETEXT JMP $EA31
2580 ;
2590 ;THIS ROUTINE FLIPS THE STACK
2600 ;MEMORY WITH A MODIFIED STACK
2610 ;IN MEMORY WITHOUT USING
2620 ;ZERO PAGE
2630 ;
2640 FLIPMM LDA #<STUFF
2650        STA TOP+1    ;SOURCE LOW
2660        STA STUFF2+1
2670        LDA #>STUFF
2680        STA TOP+2    ;SOURCE HIGH
2690        STA STUFF2+2
2700        LDA #0
2710        STA STUFF1+1 ;TARGET LOW
2720        STA STUFF3+1
2730        STA STUFF1+2 ;TARGET HIGH
2740        STA STUFF3+2
2750        LDY #4
2760        LDX #2
2770 TOPLOP LDA #52      ;OFF BASIC
2780        STA $01
2790 TOP    LDA $FFFF,X  ;SOURCE
2800        STA TMPBYT
2810        LDA #55      ;ON BASIC
2820        STA $01
2830 STUFF1 LDA $FFFF,X  ;TARGET
2840 STUFF2 STA $FFFF,X  ;SOURCE
2850        LDA TMPBYT
2860 STUFF3 STA $FFFF,X  ;TARGET
2870        INX
2880        BNE TOPLOP
2890        INC TOP+2
2900        INC STUFF1+2
2910        INC STUFF2+2
2920        INC STUFF3+2
2930        DEY
2940        BNE TOPLOP
2950        LDA STKTMP   ;FLIP STACK
2960        TSX          ;POINTERS
2970        STX STKTMP
2980        TAX
2990        TXS
3000        RTS
3010 ;
3020 START  LDY #0       ;ACTUAL START
3030        STY XPOS     ;OF SNAG CODE
3040        LDA #216
3050        STA YPOS
3060        LDA #<COLOR  ;MAKE A COPY
3070        STA BLOCKX   ;OF SCREEN
3080        LDA #>COLOR  ;COLOR
3090        STA BLOCKY
3100        LDX #4
3110 TRANS  LDA (XPOS),Y
3120        STA (BLOCKX),Y
3130        INY
3140        BNE TRANS
3150        INC YPOS
3160        INC BLOCKY
3170        DEX
3180        BNE TRANS    ;SET SNAG CUR-
3190        LDA 53281    ;SOR COLOR
3200        AND #15      ;ACCORDING TO
3210        TAX          ;TABLE
3220        LDA COLORS,X
3230        STA CURCOL
3240        LDX #255     ;DISABLE BLOCK
3250        STX BLOCKX   ;WITH TWO FF'S
3260        STX BLOCKY
3270        INX
3280        STX OLDCOL ;1 = OLD COLOR
3290        STX ADDMOV ;1 = ADD X OR Y
3300        STX FLPPLT ;1 = Y,X NOT X,Y
3310        STX OUTPUT ;1 = DISK/PRINTR
3320        STX XPOS   ;CURSOR X AND Y
3330        STX YPOS
3340        TXA
3350        TAY        ;PLOT INITIAL
3360        JSR REVERS ;CURSOR
3370 GETMOR JSR GETIN
3380        BEQ GETMOR
3390        CMP #"[133]"   ;IS IT AN F1
3400        BNE NOSTOP
3410        JSR UNBLCK ;YES, SHUT OFF
3420        LDX XPOS   ;BLOCK, ERASE
3430        LDY YPOS   ;CURSOR AND EXIT
3440        INC OLDCOL ;ACCORDING TO
3450        JSR REVERS ;THE BRK VECTOR
3460        BRK
3470        NOP:NOP:NOP ;PC RETURNS
3480        JMP START   ;HERE
3490 NOSTOP CMP #""    ;CURSOR RIGHT
3500        BNE NOTRIT
3510        LDX XPOS
3520        CPX #39
3530        BEQ NOTRIT
3540        INC ADDMOV  ;SET ADD FLAG
3550        JSR XBLOCK  ;MOVE RIGHT
3560        DEC ADDMOV  ;UNSET ADD FLAG
3570 NOTRIT CMP #"[157]"    ;CURSOR LEFT
3580        BNE NOTLFT
3590        LDX XPOS
3600        BEQ NOTLFT
3610        INC OLDCOL  ;SET COLOR FLAG
3620        JSR XBLOCK  ;MOVE LEFT
3630        DEC OLDCOL  ;UNSET COL FLAG
3640 NOTLFT CMP #""    ;CURSOR DOWN
3650        BNE NOTDWN
3660        LDX YPOS
3670        CPX #24
3680        BEQ NOTDWN
3690        INC ADDMOV  ;SET ADD FLAG
3700        JSR YBLOCK  ;MOVE DOWN
3710        DEC ADDMOV  ;UNSET ADD FLAG
3720 NOTDWN CMP #"[145]"    ;CURSOR UP
3730        BNE NOTUP
3740        LDX YPOS
3750        BEQ NOTUP
3760        INC OLDCOL  ;SET COLOR FLAG
3770        JSR YBLOCK  ;MOVE UP
3780        DEC OLDCOL  ;UNSET COL FLAG
3790 NOTUP  CMP #"[146]"    ;REVERSE OFF
3800        BNE NOTUNB
3810        JSR UNBLCK  ;SHUT OFF BLOCK
3820 NOTUNB CMP #""    ;REVERSE ON
3830        BNE NOSBLK
3840        JSR ONBLCK  ;TURN ON BLOCK
3850 NOSBLK CMP #13     ;A RETURN
3860        BNE NOTRET
3870        JMP NEWMEN  ;(null) TO NEW MENU
3880 NOTRET JMP GETMOR
3890        JMP GETMOR  ;3 EXTRA BYTES
3900        RTS         ;FOR EXPANSION
3910 ;
3920 NEWMEN JSR PLINES  ;PUT LINES ON
3930 NEWMN2 LDA CURCOL  ;SET CURSOR
3940        STA CURSCO  ;COLOR
3950        LDA #<MENU1 ;DISPLAY SNAG
3960        LDY #>MENU1 ;MENU OPTIONS
3970        JSR STRING
3980 GETNEW JSR GETIN   ;GET A KEY
3990        BEQ GETNEW
4000        CMP #"[133]"    ;IS IT AN F1
4010        BNE NOTESC  ;NO, MOVE ON
4020        JSR LEVNEW  ;YES, RETURN
4030        JMP GETMOR  ;SCREEN AND (null)
4040 NOTESC CMP #"P"    ;IS KEY PRINTER
4050        BNE NOTPNT  ;NO, MOVE ON
4060        JSR OPNPNT  ;OPEN PRINTER
4070        LDA #13     ;PRINT A CR
4080        JSR CHROUT
4090        JSR CLSFIL  ;CLOSE PRINTER
4100        LDA $90    ;IS PRINTER ON
4110        BEQ (null)AHED ;YES, MOVE ON
4120        JMP SHOERR ;NO, SHOW ERROR
4130 (null)AHED JSR OPNPNT ;RE-OPEN PRINTER
4140        JMP PROCE2 ;PRINT BLOCK
4150 OPNPNT LDY #$FF   ;DEFAULT
4160        LDA #%00000010
4170        BIT 53272   ;CHECK UP CASE
4180        BEQ UPCASE
4190        LDY #7     ;NO, PRINT LOWER
4200 UPCASE LDA #32    ;FILE NUMBER
4210        LDX #4     ;DEVICE NUMBER
4220        JSR SETLFS ;SET UP FILE #32
4230        LDA #0     ;SET NILL NAME
4240        JSR SETNAM
4250        JSR LEVNEW ;ERASE NEW MENU
4260        JSR OPEN   ;OPEN FILE #32
4270        LDX #32    ;MAKE FILE #32
4280        JSR CHKOUT ;AN OUTPUT FILE
4290        RTS
4300 NOTPNT CMP #"F"   ;IS KEY A FILE
4310        BNE GETNEW ;NO, (null) GET KEY
4320        JSR SPACE  ;CLEAR SPACE
4330        LDA #<MENU2 ;ASK FOR
4340        LDY #>MENU2 ;FILE NAME
4350        JSR STRING
4360        LDX #0
4370 MORNAM LDA FNAME,X ;PRINT LAST
4380        CMP #","    ;NAME UNTIL A
4390        BEQ NOTNAM  ;COMMA (,) IS
4400        JSR CHROUT  ;HIT
4410        INX
4420        BNE MORNAM
4430 NOTNAM LDX #22     ;POSITION
4440        LDY #20     ;CURSOR AT
4450        CLC         ;START OF INPUT
4460        JSR PLOT
4470        INC QTMODE  ;QUOTE MODE ON
4480        LDY #0
4490 READIT JSR CHRIN   ;KERNAL INPUT
4500        CMP #13
4510        BEQ ENDINP
4520        STA FNAME,Y ;STORE INPUT
4530        INY
4540        BNE READIT
4550 ENDINP LDA #","      ;TACK ON ,S,
4560        STA FNAME,Y   ;LEAVING THE
4570        LDA #"S"      ;LAST BYTE TO
4580        STA FNAME+1,Y ;BE CHOOSEN
4590        LDA #","      ;LATER
4600        STA FNAME+2,Y
4610        STY A
4620        JSR SPACE
4630        LDA #<MENU3  ;ASK FOR AN
4640        LDY #>MENU3  ;APPEND
4650        JSR STRING
4660        LDA CHOICE   ;PRINT LAST
4670        JSR CHROUT   ;CHOICE (Y =
4680        LDA #"[157]"     ;APPEND, N =
4690        JSR CHROUT   ;WRITE)
4700        INC QTMODE   ;QUOTE MODE ON
4710        JSR CHRIN    ;KERNAL INPUT
4720        TAY
4730        STY CHOICE   ;SAVE RESPONSE
4740 UNTEND JSR CHRIN    ;EMPTY INPUT
4750        CMP #13      ;BUFFER
4760        BNE UNTEND
4770        LDX CHOICE
4780        LDA #"W"     ;N = W(RITE)
4790        LDY A
4800        CPX #"Y"
4810        BNE NOTAPN
4820        LDA #"A"     ;Y = A(PPEND)
4830 NOTAPN STA FNAME+3,Y
4840        TYA
4850        CLC          ;ADJUST LENGTH
4860        ADC #4       ;OF FILE NAME
4870        LDX #<FNAME
4880        LDY #>FNAME
4890        JSR SETNAM   ;KERNAL SETNAM
4900        LDA #32
4910        LDX #8
4920        LDY #2
4930        JSR SETLFS
4940        JSR LEVNEW  ;ERASE NEW MENU
4950        LDA #8
4960        LDX #0
4970        STX $90
4980        JSR TALK    ;MAKE DISK TALK
4990        JSR UNTLK   ;TO SEE IF IT
5000        LDX $90     ;IS TURNED ON
5010        BEQ NODKER  ;ON, MOVE ON
5020        JMP SHOERR  ;OFF,SHOW ERROR
5030 NODKER JSR OPEN
5040        LDA #8       ;CHECK FOR A
5050        STA $BA      ;DISK ERROR
5060        JSR TALK     ;AFTER OPENING
5070        LDA #$6F
5080        JSR TKSA
5090        LDY #0
5100 MORERR JSR ACPTR
5110        STA ERRBUF,Y ;SAVE DISK
5120        INY          ;MESSAGE
5130        CMP #13
5140        BNE MORERR
5150        JSR UNTLK
5160        LDA #0
5170        STA ERRBUF,Y ;END WITH 0
5180        LDA ERRBUF   ;WAS THERE AN
5190        CMP #"0"     ;ERROR
5200        BEQ PROCED
5210        JSR PLINES   ;YES, DISPLAY
5220        LDA #<MESBUF ;DISK ERROR
5230        LDY #>MESBUF ;MESSAGE
5240        JSR STRING
5250        JSR CLSFIL   ;CLOSE FILE
5260        JMP WAITIT   ;EXIT NEW MENU
5270 PROCED LDX #32
5280        JSR CHKOUT
5290 ;
5300 ;THE PRINTER ALSO USES THE
5310 ;FOLLOWING CODE TO OUTPUT ITS
5320 ;BLOCK
5330 ;
5340 PROCE2 INC OUTPUT ;SET OUTPUT FLAG
5350        JSR UNBLCK ;OUTPUT BLOCK
5360        DEC OUTPUT ;UNSET OUTPUT.
5370        LDA $BA    ;CHECK DEVICE
5380        CMP #4     ;PRINTER
5390        BNE NOPRNT ;NO, MOVE ON
5400        LDA #13    ;YES, DO A CR
5410        JSR CHROUT
5420 NOPRNT JSR CLSFIL ;CLOSE FILE
5430        JMP GETMOR ;(null) TO MAIN MENU
5440 ;
5450 CLSFIL LDA #32    ;CLOSE FILE #32
5460        JSR CLOSE
5470        JMP CLALL
5480 ;
5490 SHOERR JSR PLINES ;PUT LINES ON
5500        LDX #22
5510        LDY #8
5520        CLC
5530        JSR PLOT
5540        LDA #<MENU4 ;PRINT OUTPUT
5550        LDY #>MENU4 ;DEVICE IS OFF
5560        JSR STRING
5570 WAITIT JSR GETIN   ;WAIT FOR A KEY
5580        BEQ WAITIT
5590        JSR SPACE   ;ERASE LINES
5600        JMP NEWMN2  ;OUTPUT MENU
5610 ;
5620 LEVNEW LDX #119    ;PUT OLD SCREEN
5630 LINES2 LDA MENU,X  ;BACK
5640        STA SCNLIN,X
5650        LDA MENU+120,X
5660        STA COLLIN,X
5670        DEX
5680        BPL LINES2
5690        RTS
5700 ;
5710 PLINES LDX #119
5720 LINES  LDA SCNLIN,X ;SAVE THREE
5730        STA MENU,X   ;LINES OF THE
5740        LDA COLLIN,X ;SCREEN IN MEM
5750        STA MENU+120,X
5760        LDA #64     ;USE A LINE
5770        STA SCNLIN,X
5780        LDA CURCOL  ;GET COLOR
5790        STA COLLIN,X
5800        DEX
5810        BPL LINES
5820 SPACE  LDX #39     ;CLEAR THE LINE
5830        LDA #32     ;USED FOR TEXT
5840 ZAPSCN STA TXTLIN,X
5850        DEX
5860        BPL ZAPSCN
5870        LDX #22
5880        LDY #0      ;POSITION
5890        CLC         ;CURSOR AND
5900        JMP PLOT    ;RETURN
5910 ;
5920 ;CONVERTS X , Y INTO LOW , HIGH
5930 ;
5940 MAKEXY LDA FLPPLT ;IS PLOT NORMAL
5950        BEQ NORMAL
5960        STX YTEMP  ;FLIPPED Y,X
5970        STY XTEMP
5980        JMP THEPLT
5990 NORMAL STX XTEMP   ;NORMAL X,Y
6000        STY YTEMP
6010 THEPLT LDA #4      ;SCREEN HIGH
6020        STA HIGHPT
6030        LDA #>COLOR ;SAVED COLOR
6040        STA COLHII  ;HIGH BYTE
6050        LDA #0     ;START MULT AT 0
6060        LDX YTEMP  ;MULT .X TIMES
6070        BEQ NOMULT
6080 MORMLT CLC
6090        ADC #40     ;MULT. BY 40
6100        BCC NOBRK   ;Y POSITION
6110        INC HIGHPT
6120        INC COLHII
6130 NOBRK  DEX
6140        BNE MORMLT
6150 NOMULT CLC
6160        ADC XTEMP   ;ADD HOW MANY
6170        BCC NOTBRK  ;OVER
6180        INC HIGHPT
6190        INC COLHII
6200 NOTBRK STA LOWPNT
6210        RTS
6220 ;
6230 REVERS JSR MAKEXY
6240        LDY #0
6250        LDA (LOWPNT),Y ;GET CHARAC.
6260        EOR #128  ;INVERT CHARACTER
6270        STA LASTCH ;SAVE CHARACTER
6280        STA (LOWPNT),Y ;PUT CHARAC.
6290        LDA HIGHPT
6300        AND #$03   ;PREPARE HIGH
6310        ORA #$D8   ;BYTE FOR COLOR
6320        STA HIGHPT
6330        LDA #<COLOR ;SET LOW BYTE
6340        CLC         ;FOR ORIGINAL
6350        ADC LOWPNT  ;SCREEN COLOR
6360        BCC NOCOBK  ;SAVED IN MEM
6370        INC COLHII
6380 NOCOBK STA COLLOW
6390        LDA CURCOL ;GET CURRENT COL
6400        LDX OLDCOL ;USE OLD COLOR
6410        BEQ STRCOL ;NO, MOVE ON
6420        LDA (COLLOW),Y ;YES, GET IT
6430 STRCOL STA (LOWPNT),Y ;STORE COLOR
6440        RTS
6450 ;
6460 PLOTXY LDX XPTEMP
6470        LDY YPTEMP
6480        JMP REVERS
6490 ;
6500 CURSOR LDA OLDCOL ;SAVE COLOR FLAG
6510        PHA
6520        LDA #0
6530        STA OLDCOL ;PLOT SNAG CURSR
6540        JSR PLOTXY
6550        PLA        ;RESET COLOR
6560        STA OLDCOL ;FLAG
6570        RTS
6580 ;
6590 ASCII  CMP #$20   ;FROM MEMORY
6600        BCS ONE    ;TO ASCII
6610 THREE  CLC
6620        ADC #$40
6630        RTS
6640 ONE    CMP #$40
6650        BCS TWO
6660        RTS
6670 TWO    CMP #$60
6680        BCS THREE
6690        CLC
6700        ADC #$20
6710        RTS
6720 ;
6730 ;THE FOLLOWING CODE EITHER PLOTS A
6740 ;A SINGLE REVERSED SPACE OR
6750 ;REVERSES A LINE IF THE BLOCK IS
6760 ;TURNED ON
6770 ;
6780 (null)SCRN LDA XPTEMP
6790        CMP XBTEMP
6800        BMI ONEBLK
6810        LDA YPTEMP
6820        CMP YBTEMP
6830        BCS XXBLCK
6840 ONEBLK INC OLDCOL
6850        JSR PLOTXY
6860        DEC OLDCOL
6870        LDA ADDMOV
6880        BEQ SUBIT
6890        INC XPTEMP ;INCREMENT X POS
6900        LDA XPTEMP ;IS X ON BLOCK
6910        CMP XBTEMP
6920        BNE OUTHRE
6930        DEC XPTEMP
6940        LDA YPTEMP  ;YES, BUT BE
6950        CMP YBTEMP  ;SURE Y POS IS
6960        BCS XXBLCK  ;ON BLOCK TOO
6970        INC XPTEMP
6980        BNE OUTHRE
6990 SUBIT  DEC XPTEMP
7000 OUTHRE JMP CURSOR
7010 XXBLCK LDA ADDMOV  ;IS IT AN ADD
7020        BEQ NOTADD  ;0 = SUB
7030        INC XPTEMP  ;OTHERWISE ADD
7040 NOTADD INC YPTEMP
7050        LDA XPTEMP
7060        STA A
7070        LDA YBTEMP
7080        STA B
7090 MORLIN LDX A
7100        LDY B
7110        JSR REVERS
7120        INC B
7130        LDA B
7140        CMP YPTEMP
7150        BNE MORLIN
7160        DEC YPTEMP
7170        LDA ADDMOV ;WAS IT A SUB
7180        BNE NOADDD ;1 = ADD
7190        LDA XPTEMP
7200        CMP XBTEMP
7210        BNE NOTTND
7220        DEC XPTEMP
7230        JMP CURSOR
7240 NOTTND DEC XPTEMP ;OTHERWISE SUB
7250 NOADDD RTS
7260 ;
7270 XBLOCK LDA XPOS   ;PREPARE TEMPS
7280        STA XPTEMP ;FOR A RIGHT OR
7290        LDA YPOS   ;LEFT BLOCK MOVE
7300        STA YPTEMP
7310        LDA BLOCKX
7320        STA XBTEMP
7330        LDA BLOCKY
7340        STA YBTEMP
7350        JSR (null)SCRN ;DO THE MOVE
7360        LDA XPTEMP ;GET CHANGED
7370        STA XPOS   ;POSITION VALUES
7380        LDA YPTEMP
7390        STA YPOS
7400        LDA #0
7410        RTS
7420 ;
7430 YBLOCK INC FLPPLT ;PREPARE TEMPS
7440        LDA XPOS   ;FOR AN UP OR
7450        STA YPTEMP ;DOWN BLOCK MOVE
7460        LDA YPOS
7470        STA XPTEMP
7480        LDA BLOCKX
7490        STA YBTEMP
7500        LDA BLOCKY
7510        STA XBTEMP
7520        JSR (null)SCRN ;DO THE MOVE
7530        LDA XPTEMP ;GET CHANGED
7540        STA YPOS   ;POSITION VALUES
7550        LDA YPTEMP
7560        STA XPOS
7570        LDA #0
7580        STA FLPPLT
7590        RTS
7600 ;
7610 UNBLCK LDA XPOS   ;IS XPOS INSIDE
7620        CMP BLOCKX ;OF BLOCK
7630        BMI NOBLCK ;NO, LEAVE HERE
7640        LDA YPOS   ;IS YPOS INSIDE
7650        CMP BLOCKY ;OF BLOCK
7660        BMI NOBLCK ;NO, LEAVE HERE
7670        LDA BLOCKY
7680        CMP #$FF   ;IS BLOCK OFF
7690        BEQ NOBLCK ;YES, LEAVE HERE
7700        STA YPTEMP
7710        INC OLDCOL ;RESET OLD COLOR
7720 ;
7730 ;THIS NEXT PART FINDS THE END OF
7740 ;EACH BLOCK LINE SO NO SPACES ARE
7750 ;CONSIDERED AS OUTPUT.  THE NEXT
7760 ;SECTION THEN UN-DOES THE BLOCK
7770 ;AND OUTPUTS DATA IF THE OUTPUT
7780 ;FLAG IS NON-ZERO.
7790 ;
7800 REDUCE LDA XPOS
7810        STA A
7820        LDA BLOCKX
7830        STA XPTEMP
7840        LDA YPTEMP
7850        STA B
7860 MORRED JSR GETXY
7870        CMP #160   ;IS IT A SPACE
7880        BNE MOREX  ;NO, END FOUND
7890        LDX A      ;YES, UN-DO IT
7900        LDY B
7910        JSR REVERS ;UNREVERSE SPACE
7920        LDA A      ;HAS A LINE BEEN
7930        CMP BLOCKX ;REDUCED
7940        BEQ YESX   ;YES, LEAVE HERE
7950        DEC A      ;NO, MOVE LEFT
7960        JMP MORRED ;TO NEXT COLUMN
7970 ;
7980 MOREX  JSR PLOTXY ;INVERSE CHAR
7990        LDA OUTPUT ;DISK OR PRINTER
8000        BEQ NOTOUT ;NO, SKIP OUTPUT
8010        LDA LASTCH ;GET CHARACTER
8020        CMP #127
8030        BCC OKSIZE
8040        EOR #$80
8050 OKSIZE JSR ASCII  ;POKE TO ASCII
8060        JSR CHROUT  ;OUTPUT IT
8070 NOTOUT LDA XPTEMP
8080        CMP A      ;IS ROW ERASED
8090        BEQ YESX
8100        INC XPTEMP ;NO, ADD COLUMN
8110        BNE MOREX  ;AND (null) BACK
8120 YESX   LDA YPTEMP
8130        CMP YPOS   ;ARE ROWS DONE
8140        BEQ YESY
8150        LDA OUTPUT
8160        BEQ NOCR
8170        LDA #13    ;OUTPUT ENDOFLNE
8180        JSR CHROUT
8190 NOCR   INC YPTEMP ;NO, ADD ROW
8200        BNE REDUCE ;AND (null) BACK
8210 YESY   DEC OLDCOL ;OFF COLOR FLAG
8220        LDA OUTPUT ;ONE MORE CR
8230        BEQ NOWAY
8240        LDA #13
8250        JSR CHROUT
8260 NOWAY  LDA XPOS
8270        STA XPTEMP
8280        JSR PLOTXY ;TURN ON CURSOR
8290 NOBLCK LDA #$FF
8300        STA BLOCKX ;TURN OFF BLOCK
8310        STA BLOCKY ;WITH TWO $FF'S
8320        RTS
8330 ;
8340 GETXY  LDX A
8350        LDY B
8360        JSR MAKEXY
8370        LDY #0
8380        LDA (LOWPNT),Y
8390        RTS
8400 ;
8410 ONBLCK JSR UNBLCK ;UN DO BLOCK
8420        LDA XPOS   ;START BLOCK AT
8430        STA BLOCKX ;CURSOR X AND Y
8440        LDA YPOS
8450        STA BLOCKY
8460        LDA #0
8470        RTS
8480 ;
8490 MENU1  .ASC "   (F) FILE "
8500        .ASC "  (P) PRINTER  "
8510        .ASC " (F1) EXIT"
8520        .BYT 0
8530 MENU2  .ASC "   ENTER"
8540        .ASC " FILE NAME: "
8550        .BYT 0
8560 MENU3  .ASC " APPEND TO THIS"
8570        .ASC " EXISTING FILE"
8580        .ASC " (Y/N)? "
8590        .BYT 0
8600 MENU4  .ASC "OUTPUT DEVICE NOT "
8610        .ASC "PRESENT"
8620        .BYT 0
8630 COLORS .BYT 5,14,15,6,6,0,15,5
8640        .BYT 0,3,6,14,2,6,11,10
8650 MESBUF .ASC " DISK: "
8660 ERRBUF = *
8670 *=* + 40
8680 COLOR = *
8690 *=* + 1024
8700 MENU = *
8710 *=* + 240
8720 FNAME = *
8730 *=* + 20
8740 STKTMP = *
8750 *=*+1
8760 TMPBYT = *
8770 *=*+1